home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / a2.0bemacs-src.lha / Emacs-19.25 / src / amiga_fns.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-28  |  16.1 KB  |  548 lines
  1. /* Functions for the Amiga Intuition Windows system.
  2.    Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Adapted from xnfs.c, 08/27/94 Carsten Heyl,
  21.    some stuff moved from David Gays amiga_screen.c  */
  22.  
  23. #include <exec/types.h>
  24. #include <libraries/gadtools.h>
  25. #include <intuition/intuition.h>
  26. #include <proto/exec.h>
  27. #include <proto/dos.h>
  28. #include <proto/gadtools.h>
  29. #include <proto/intuition.h>
  30.  
  31. #include "config.h"
  32. #include "lisp.h"
  33. #include "frame.h"
  34. #include "amiga.h"
  35.  
  36. #ifdef USE_PROTOS
  37. #include "protos.h"
  38. #endif
  39.  
  40. /* CHFIXME: change more functions to amiga version */
  41.  
  42. /* Evaluate this expression to rebuild the section of syms_of_xfns
  43.    that initializes and staticpros the symbols declared below.  Note
  44.    that Emacs 18 has a bug that keeps C-x C-e from being able to
  45.    evaluate this expression.
  46.  
  47. (progn
  48.   ;; Accumulate a list of the symbols we want to initialize from the
  49.   ;; declarations at the top of the file.
  50.   (goto-char (point-min))
  51.   (search-forward "/\*&&& symbols declared here &&&*\/\n")
  52.   (let (symbol-list)
  53.     (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
  54.       (setq symbol-list
  55.         (cons (buffer-substring (match-beginning 1) (match-end 1))
  56.           symbol-list))
  57.       (forward-line 1))
  58.     (setq symbol-list (nreverse symbol-list))
  59.     ;; Delete the section of syms_of_... where we initialize the symbols.
  60.     (search-forward "\n  /\*&&& init symbols here &&&*\/\n")
  61.     (let ((start (point)))
  62.       (while (looking-at "^  Q")
  63.     (forward-line 2))
  64.       (kill-region start (point)))
  65.     ;; Write a new symbol initialization section.
  66.     (while symbol-list
  67.       (insert (format "  %s = intern (\"" (car symbol-list)))
  68.       (let ((start (point)))
  69.     (insert (substring (car symbol-list) 1))
  70.     (subst-char-in-region start (point) ?_ ?-))
  71.       (insert (format "\");\n  staticpro (&%s);\n" (car symbol-list)))
  72.       (setq symbol-list (cdr symbol-list)))))
  73.  
  74.   */        
  75.  
  76. /*&&& symbols declared here &&&*/
  77. #if 0
  78. Lisp_Object Qauto_raise;
  79. Lisp_Object Qauto_lower;
  80. #endif
  81. Lisp_Object Qbackground_color;
  82. #if 0
  83. Lisp_Object Qbar;
  84. #endif
  85. Lisp_Object Qborder_color;
  86. Lisp_Object Qborder_width;
  87. #if 0
  88. Lisp_Object Qbox;
  89. Lisp_Object Qcursor_color;
  90. Lisp_Object Qcursor_type;
  91. Lisp_Object Qfont;
  92. #endif
  93. Lisp_Object Qforeground_color;
  94. #if 0
  95. Lisp_Object Qgeometry;
  96. Lisp_Object Qicon_left;
  97. Lisp_Object Qicon_top;
  98. Lisp_Object Qicon_type;
  99. Lisp_Object Qinternal_border_width;
  100. #endif
  101. Lisp_Object Qleft;
  102. #if 0
  103. Lisp_Object Qmouse_color;
  104. Lisp_Object Qnone;
  105. Lisp_Object Qparent_id;
  106. Lisp_Object Qsuppress_icon;
  107. #endif
  108. Lisp_Object Qtop;
  109. #if 0
  110. Lisp_Object Qundefined_color;
  111. Lisp_Object Qvertical_scroll_bars;
  112. Lisp_Object Qvisibility;
  113. Lisp_Object Qwindow_id;
  114. #endif
  115. Lisp_Object Qamiga_frame_parameter;
  116. #if 0
  117. Lisp_Object Quser_position;
  118. Lisp_Object Quser_size;
  119. #endif
  120.  
  121. /* The below are defined in frame.c. */
  122. extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
  123. extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
  124.  
  125. extern Lisp_Object Vwindow_system_version;
  126.  
  127.  
  128. /* Connect the frame-parameter names for X frames
  129.    to the ways of passing the parameter values to the window system.
  130.  
  131.    The name of a parameter, as a Lisp symbol,
  132.    has an `amiga-frame-parameter' property which is an integer in Lisp
  133.    but can be interpreted as an `enum amiga_frame_parm' in C.  */
  134.  
  135. enum amiga_frame_parm
  136. {
  137.   AMIGA_PARM_FOREGROUND_COLOR,
  138.   AMIGA_PARM_BACKGROUND_COLOR,
  139.   AMIGA_PARM_MOUSE_COLOR,
  140.   AMIGA_PARM_CURSOR_COLOR,
  141.   AMIGA_PARM_BORDER_COLOR,
  142.   AMIGA_PARM_ICON_TYPE,
  143.   AMIGA_PARM_FONT,
  144.   AMIGA_PARM_BORDER_WIDTH,
  145.   AMIGA_PARM_INTERNAL_BORDER_WIDTH,
  146.   AMIGA_PARM_NAME,
  147.   AMIGA_PARM_AUTORAISE,
  148.   AMIGA_PARM_AUTOLOWER,
  149.   AMIGA_PARM_VERT_SCROLL_BAR,
  150.   AMIGA_PARM_VISIBILITY,
  151.   AMIGA_PARM_MENU_BAR_LINES
  152. };
  153.  
  154.  
  155. struct amiga_frame_parm_table
  156. {
  157.   char *name;
  158.   void (*setter)( FRAME_PTR frame, Lisp_Object val, Lisp_Object oldval);
  159. };
  160.  
  161. void amiga_set_foreground_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  162. void amiga_set_background_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  163. void amiga_set_mouse_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  164. void amiga_set_cursor_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  165. void amiga_set_border_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  166. void amiga_set_cursor_type (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  167. void amiga_set_icon_type (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  168. void amiga_set_font (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  169. void amiga_set_border_width (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  170. void amiga_set_internal_border_width (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  171. void amiga_explicitly_set_name (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  172. void amiga_set_autoraise (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  173. void amiga_set_autolower (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  174. void amiga_set_vertical_scroll_bars (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  175. void amiga_set_visibility (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  176. void x_set_menu_bar_lines (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval);
  177.  
  178. static struct amiga_frame_parm_table __far amiga_frame_parms[] =
  179. {
  180.   "foreground-color", amiga_set_foreground_color,
  181.   "background-color", amiga_set_background_color,
  182.   "mouse-color", amiga_set_mouse_color,
  183.   "cursor-color", amiga_set_cursor_color,
  184.   "border-color", amiga_set_border_color,
  185.   "cursor-type", amiga_set_cursor_type,
  186.   "icon-type", amiga_set_icon_type,
  187.   "font", amiga_set_font,
  188.   "border-width", amiga_set_border_width,
  189.   "internal-border-width", amiga_set_internal_border_width,
  190.   "name", amiga_explicitly_set_name,
  191.   "auto-raise", amiga_set_autoraise,
  192.   "auto-lower", amiga_set_autolower,
  193.   "vertical-scroll-bars", amiga_set_vertical_scroll_bars,
  194.   "visibility", amiga_set_visibility,
  195.   "menu-bar-lines", x_set_menu_bar_lines,
  196. };
  197.  
  198. /* Attach the `amiga-frame-parameter' properties to
  199.    the Lisp symbol names of parameters relevant to X.  */
  200.  
  201. init_amiga_parm_symbols ()
  202. {
  203.   int i;
  204.  
  205.   for (i = 0; i < sizeof (amiga_frame_parms) / sizeof (amiga_frame_parms[0]); i++)
  206.     Fput (intern (amiga_frame_parms[i].name), Qamiga_frame_parameter,
  207.       make_number (i));
  208. }
  209.  
  210. /* Change the parameters of FRAME as specified by ALIST.
  211.    If a parameter is not specially recognized, do nothing;
  212.    otherwise call the `amiga_set_...' function for that parameter.  */
  213.  
  214. void
  215. x_set_frame_parameters (f, alist) /* CHFIXME: fix references in window.c */
  216.      FRAME_PTR f;
  217.      Lisp_Object alist;
  218. {
  219.   Lisp_Object tail;
  220.  
  221.   /* If both of these parameters are present, it's more efficient to
  222.      set them both at once.  So we wait until we've looked at the
  223.      entire list before we set them.  */
  224.   Lisp_Object width, height;
  225.  
  226.   /* Same here.  */
  227.   Lisp_Object left, top;
  228.  
  229.   /* Record in these vectors all the parms specified.  */
  230.   Lisp_Object *parms;
  231.   Lisp_Object *values;
  232.   int i;
  233.   
  234.   i = 0;
  235.   for (tail = alist; CONSP (tail); tail = Fcdr (tail))
  236.     i++;
  237.  
  238.   parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
  239.   values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
  240.  
  241.   /* Extract parm names and values into those vectors.  */
  242.  
  243.   i = 0;
  244.   for (tail = alist; CONSP (tail); tail = Fcdr (tail))
  245.     {
  246.       Lisp_Object elt, prop, val;
  247.  
  248.       elt = Fcar (tail);
  249.       parms[i] = Fcar (elt);
  250.       values[i] = Fcdr (elt);
  251.       i++;
  252.     }
  253.  
  254.   width = height = top = left = Qunbound;
  255.  
  256.   /* Now process them in reverse of specified order.  */
  257.   for (i--; i >= 0; i--)
  258.     {
  259.       Lisp_Object prop, val;
  260.  
  261.       prop = parms[i];
  262.       val = values[i];
  263.  
  264.       if (EQ (prop, Qwidth))
  265.     width = val;
  266.       else if (EQ (prop, Qheight))
  267.     height = val;
  268.       else if (EQ (prop, Qtop))
  269.     top = val;
  270.       else if (EQ (prop, Qleft))
  271.     left = val;
  272.       else
  273.     {
  274.       register Lisp_Object param_index, old_value;
  275.  
  276.       param_index = Fget (prop, Qamiga_frame_parameter);
  277.       old_value = get_frame_param (f, prop);
  278.       store_frame_param (f, prop, val);
  279.       if (XTYPE (param_index) == Lisp_Int
  280.           && XINT (param_index) >= 0
  281.           && (XINT (param_index)
  282.           < sizeof (amiga_frame_parms)/sizeof (amiga_frame_parms[0])))
  283.         (*amiga_frame_parms[XINT (param_index)].setter)(f, val, old_value);
  284.     }
  285.     }
  286.  
  287.   /* Don't die if just one of these was set.  */
  288.   if (EQ (left, Qunbound))
  289.     XSET (left, Lisp_Int, EMACS_WIN(f)->LeftEdge);
  290.   if (EQ (top, Qunbound))
  291.     XSET (top, Lisp_Int, EMACS_WIN(f)->TopEdge);
  292.  
  293.   /* Don't die if just one of these was set.  */
  294.   if (EQ (width, Qunbound))
  295.     XSET (width, Lisp_Int, FRAME_WIDTH (f));
  296.   if (EQ (height, Qunbound))
  297.     XSET (height, Lisp_Int, FRAME_HEIGHT (f));
  298.  
  299. #if 0 /* CHFIXME */
  300.   /* Don't set these parameters these unless they've been explicitly
  301.      specified.  The window might be mapped or resized while we're in
  302.      this function, and we don't want to override that unless the lisp
  303.      code has asked for it.
  304.  
  305.      Don't set these parameters unless they actually differ from the
  306.      window's current parameters; the window may not actually exist
  307.      yet.  */
  308.   {
  309.     Lisp_Object frame;
  310.  
  311.     check_frame_size (f, &height, &width);
  312.  
  313.     XSET (frame, Lisp_Frame, f);
  314.  
  315.     if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
  316.     || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
  317.       Fset_frame_size (frame, width, height);
  318.     if ((NUMBERP (left) && XINT (left) != emacs_win->LeftEdge)
  319.     || (NUMBERP (top) && XINT (top) != emacs_win->TopEdge))
  320.       Fset_frame_position (frame, left, top);
  321.   }
  322. #endif
  323. }
  324.  
  325. /* Insert a description of internally-recorded parameters of frame X
  326.    into the parameter alist *ALISTPTR that is to be given to the user.
  327.    Only parameters that are specific to the X window system
  328.    and whose values are not correctly recorded in the frame's
  329.    param_alist need to be considered here.  */
  330.  
  331. x_report_frame_params (f, alistptr) /* CHFIXME: fix references in frame.c */
  332.      FRAME_PTR f;
  333.      Lisp_Object *alistptr;
  334. {
  335.   char buf[16];
  336.  
  337.   store_in_alist (alistptr, Qleft, make_number (EMACS_WIN(f)->LeftEdge));
  338.   store_in_alist (alistptr, Qtop, make_number (EMACS_WIN(f)->TopEdge));
  339. #if 0 /* CHFIXME: available on the AMIGA ! */
  340.   store_in_alist (alistptr, Qborder_width,
  341.               make_number (f->display.x->border_width));
  342.   store_in_alist (alistptr, Qinternal_border_width,
  343.               make_number (f->display.x->internal_border_width));
  344.   sprintf (buf, "%d", FRAME_AMIGA_WINDOW (f));
  345.   store_in_alist (alistptr, Qwindow_id,
  346.               build_string (buf));
  347.   FRAME_SAMPLE_VISIBILITY (f);
  348.   store_in_alist (alistptr, Qvisibility,
  349.           (FRAME_VISIBLE_P (f) ? Qt
  350.            : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
  351. #endif
  352. }
  353.  
  354. #define CHFIXMELINE() fprintf(stderr,"CHFIXME: %s %d\n", __FILE__, __LINE__)
  355.  
  356. void amiga_set_foreground_color (FRAME_PTR f, Lisp_Object pen, Lisp_Object oldval)
  357. {
  358.     int fg;
  359.     extern int foreground; /* CHFIXME */
  360.     
  361.   check_intuition();
  362.   CHECK_NUMBER(pen, 0);
  363.  
  364.   fg = XUINT (pen);
  365.   if (pen > 7) error("Pen colors must be between 0 & 7");
  366.   foreground = fg;
  367.   reset_window(f);
  368. }
  369. void amiga_set_background_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  370. {
  371.   CHFIXMELINE();
  372. }
  373. void amiga_set_mouse_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  374. {
  375.   CHFIXMELINE();
  376. }
  377. void amiga_set_cursor_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  378. {
  379.   CHFIXMELINE();
  380. }
  381. void amiga_set_border_color (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  382. {
  383.   CHFIXMELINE();
  384. }
  385. void amiga_set_cursor_type (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  386. {
  387.   CHFIXMELINE();
  388. }
  389. void amiga_set_icon_type (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  390. {
  391.   CHFIXMELINE();
  392. }
  393. void amiga_set_font (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  394. {
  395.   CHFIXMELINE();
  396. }
  397. void amiga_set_border_width (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  398. {
  399.   CHFIXMELINE();
  400. }
  401. void amiga_set_internal_border_width (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  402. {
  403.   CHFIXMELINE();
  404. }
  405. void amiga_explicitly_set_name (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  406. {
  407.   CHFIXMELINE();
  408. }
  409. void amiga_set_autoraise (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  410. {
  411.   CHFIXMELINE();
  412. }
  413. void amiga_set_autolower (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  414. {
  415.   CHFIXMELINE();
  416. }
  417. void amiga_set_vertical_scroll_bars (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  418. {
  419.   CHFIXMELINE();
  420. }
  421. void amiga_set_visibility (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)
  422. {
  423.   CHFIXMELINE();
  424. }
  425.  
  426. void
  427. x_set_menu_bar_lines (FRAME_PTR f, Lisp_Object value, Lisp_Object oldval)/* CHFIXME: fix references in frame.c */
  428. {
  429.   int nlines;
  430.   int olines = FRAME_MENU_BAR_LINES (f);
  431.  
  432.   fprintf(stderr,"amiga_set_menu_bar_lines\n");
  433.  
  434.   /* Right now, menu bars don't work properly in minibuf-only frames;
  435.      most of the commands try to apply themselves to the minibuffer
  436.      frame itslef, and get an error because you can't switch buffers
  437.      in or split the minibuffer window.  */
  438.   if (FRAME_MINIBUF_ONLY_P (f))
  439.     return;
  440.  
  441.   if (XTYPE (value) == Lisp_Int)
  442.     nlines = XINT (value);
  443.   else
  444.     nlines = 0;
  445.  
  446.   FRAME_MENU_BAR_LINES (f) = 0;
  447.   fprintf(stderr,"\tnlines = %d\n", nlines);
  448.   if (nlines)
  449.     FRAME_EXTERNAL_MENU_BAR (f) = 1;
  450.   else
  451.     {
  452. #if 0 /* CHFIXME */
  453.       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
  454.       free_frame_menubar (f);
  455. #endif
  456.       FRAME_EXTERNAL_MENU_BAR (f) = 0;
  457. #if 0
  458.       f->display.x->menubar_widget = 0;
  459. #endif
  460.     }
  461. }
  462.  
  463. void syms_of_amiga_fns(void)
  464. {
  465.   /* The section below is built by the lisp expression at the top of the file,
  466.      just above where these variables are declared.  */
  467.   /*&&& init symbols here &&&*/
  468. #if 0
  469.   Qauto_raise = intern ("auto-raise");
  470.   staticpro (&Qauto_raise);
  471.   Qauto_lower = intern ("auto-lower");
  472.   staticpro (&Qauto_lower);
  473. #endif
  474.   Qbackground_color = intern ("background-color");
  475.   staticpro (&Qbackground_color);
  476. #if 0
  477.   Qbar = intern ("bar");
  478.   staticpro (&Qbar);
  479. #endif
  480.   Qborder_color = intern ("border-color");
  481.   staticpro (&Qborder_color);
  482.   Qborder_width = intern ("border-width");
  483.   staticpro (&Qborder_width);
  484. #if 0
  485.   Qbox = intern ("box");
  486.   staticpro (&Qbox);
  487.   Qcursor_color = intern ("cursor-color");
  488.   staticpro (&Qcursor_color);
  489.   Qcursor_type = intern ("cursor-type");
  490.   staticpro (&Qcursor_type);
  491.   Qfont = intern ("font");
  492.   staticpro (&Qfont);
  493. #endif
  494.   Qforeground_color = intern ("foreground-color");
  495.   staticpro (&Qforeground_color);
  496. #if 0
  497.   Qgeometry = intern ("geometry");
  498.   staticpro (&Qgeometry);
  499.   Qicon_left = intern ("icon-left");
  500.   staticpro (&Qicon_left);
  501.   Qicon_top = intern ("icon-top");
  502.   staticpro (&Qicon_top);
  503.   Qicon_type = intern ("icon-type");
  504.   staticpro (&Qicon_type);
  505.   Qinternal_border_width = intern ("internal-border-width");
  506.   staticpro (&Qinternal_border_width);
  507. #endif
  508.   Qleft = intern ("left");
  509.   staticpro (&Qleft);
  510. #if 0
  511.   Qmouse_color = intern ("mouse-color");
  512.   staticpro (&Qmouse_color);
  513.   Qnone = intern ("none");
  514.   staticpro (&Qnone);
  515.   Qparent_id = intern ("parent-id");
  516.   staticpro (&Qparent_id);
  517.   Qsuppress_icon = intern ("suppress-icon");
  518.   staticpro (&Qsuppress_icon);
  519. #endif
  520.   Qtop = intern ("top");
  521.   staticpro (&Qtop);
  522. #if 0
  523.   Qundefined_color = intern ("undefined-color");
  524.   staticpro (&Qundefined_color);
  525.   Qvertical_scroll_bars = intern ("vertical-scroll-bars");
  526.   staticpro (&Qvertical_scroll_bars);
  527.   Qvisibility = intern ("visibility");
  528.   staticpro (&Qvisibility);
  529.   Qwindow_id = intern ("window-id");
  530.   staticpro (&Qwindow_id);
  531. #endif
  532.   Qamiga_frame_parameter = intern ("x-frame-parameter");
  533.   staticpro (&Qamiga_frame_parameter);
  534. #if 0
  535.   Quser_position = intern ("user-position");
  536.   staticpro (&Quser_position);
  537.   Quser_size = intern ("user-size");
  538.   staticpro (&Quser_size);
  539. #endif
  540.   /* This is the end of symbol initialization.  */
  541.  
  542.   init_amiga_parm_symbols ();
  543. }
  544.  
  545. void init_amiga_fns(void)
  546. {
  547. }
  548.